home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / code_gen / vbxwzrd / redgreen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-20  |  4.2 KB  |  127 lines
  1. {
  2.   Program: RedGreen
  3.   Date: 20/2/1995
  4.   Purpose: To create a custom control (vbx) for Visual Basic or Delphi
  5. }
  6. Library RedGreen;
  7. {$R RedGreen}
  8. Uses WinTypes,WinProcs,VBApi;
  9. { Custom control data and structs }
  10. Type PRedGreen=^TRedGreen;
  11.      TRedGreen=Record
  12.       About:Enum;
  13.       Value:Bool;
  14.      End;
  15. Const 
  16. { Declare Property }
  17.       Property_About:TPROPINFO=(
  18.       npszName:NPnt(PChar('(About)'));
  19.       fl:DT_ENUM or PF_fGetData or PF_fSetData or PF_fSetMsg;
  20.       offsetData:Byte(0);
  21.       infoData:0;
  22.       dataDefault:0;
  23.       npszEnumList:Npnt(PChar('Click on "..." for About Box'+#0+#0));
  24.       enumMax:0);
  25.       Property_Value:TPROPINFO=(
  26.       npszName:NPnt(PChar('Value'));
  27.       fl:DT_BOOL or PF_fGetData or PF_fSaveData or PF_fSetData or PF_fSetMsg;
  28.       offsetData:Byte(1);
  29.       infoData:0;
  30.       dataDefault:0;
  31.       npszEnumList:Npnt(PChar(+#0+#0));
  32.       enumMax:0);
  33. { Declare Events }
  34. { Property List }
  35.       PropListRedGreen:array[0..11] of PPropInfo=(
  36.       PPropInfo_Std_CTLNAME,
  37.       PPropInfo_Std_HWND,
  38.       PPropInfo_Std_INDEX,
  39.       PPropInfo(@Property_About),
  40.       PPropInfo_Std_ENABLED,
  41.       PPropInfo_Std_HEIGHT,
  42.       PPropInfo_Std_LEFT,
  43.       PPropInfo_Std_TOP,
  44.       PPropInfo_Std_VISIBLE,
  45.       PPropInfo_Std_WIDTH,
  46.       PPropInfo(@Property_Value),0);
  47. { Event List }
  48.       EventListRedGreen:array[0..1] of PEventInfo=(
  49.       PEventInfo_Std_MOUSEMOVE,0);
  50. { This routine handles the 'About' Dialog messages }
  51. function AboutDlgProc(Dlg:HWnd;Msg,wParam:Word;lParam:LongInt):Bool; export;
  52. begin
  53.   AboutDlgProc:=False;
  54.   case Msg of
  55.     WM_Create:AboutDlgProc:=True;
  56.     WM_InitDialog:Exit;
  57.     WM_Command:if (wParam=id_OK)or(wParam=id_Cancel) then EndDialog(Dlg,0);
  58.   end;{End of Case}
  59. end;
  60. { Constans and Variables }
  61. var RG:hBitmap;
  62. { Control Procedure }
  63. { This routine is called for all VB and Windows Messages }
  64. function RedGreenCtlProc(Control:hCtl;Wnd:hWnd;Msg,wParam:Word;lParam:LongInt):LongInt; Export;
  65. var Value:Bool;
  66.     TP:TPaintStruct;
  67.     hBrOld,hBR:hBrush;
  68.     MemDC:hDC;
  69. begin
  70.   case Msg of
  71.     WM_PAINT:
  72.     begin
  73.       BeginPaint(Wnd,TP);
  74.       hBR:=GetBrushOrg(TP.hDC);
  75.       if Bool(hbr) then hbrOld:=SelectObject(TP.hDC,hBR);
  76.       MemDC:=CreateCompatibleDC(TP.hDC);
  77.       SelectObject(MemDC,RG);
  78.       VBGetControlProperty(Control,10,@Value);
  79.       if Value then BitBlt(TP.hDC,0,0,29,16,MemDC,0,0,SrcCopy)
  80.       else BitBlt(TP.hDC,0,0,29,16,MemDC,0,16,SrcCopy);
  81.       SelectObject(TP.hDC,hbrOld);
  82.       DeleteDC(MemDC);
  83.       EndPaint(Wnd,TP);
  84.     end;
  85.     VBM_SETPROPERTY:if wParam=10 then Invalidaterect(Wnd,nil,False);
  86.     WM_USER:VBDialogBoxParam(hInstance,'ABOUT',@AboutDlgProc,0);WM_USER+1:VBDialogBoxParam(hInstance,'ABOUT',@AboutDlgProc,0);
  87.     VBM_INITPROPPOPUP:if wParam=3 then
  88.     begin
  89.       RedGreenCtlProc:=LoWord(lParam+1);
  90.       PostMessage(Wnd,WM_USER,0,0);
  91.       Exit;
  92.     end;
  93.   end;    { End of case Msg }
  94.   RedGreenCtlProc:=VBDefControlProc(Control,Wnd,Msg,wParam,lParam);
  95. end; {End of Control function}
  96. { Model struct                               }
  97. { Define the control model                   }
  98. { (using the event and property structures). }
  99. Const ModelRedGreen:TModel=(
  100.       UsVersion:VB300_VERSION;    { VB version used by control }
  101.       Fl:0;
  102.       CtlProc:TFarProc(@RedGreenCtlProc);
  103.       FsClassStyle:0 or cs_HRedraw or cs_VRedraw;
  104.       FlWndStyle:0;
  105.       CbCtlExtra:SizeOf(TRedGreen);
  106.       IdBmpPalette:8000;          { Bitmap ID for tool palette }
  107.       DefCtlName:NPnt(PChar('RedGreen'));
  108.       ClassName:NPnt(PChar('RedGreen'));
  109.       ParentClassName:0;
  110.       PropList:Ofs(PropListRedGreen);
  111.       EventList:Ofs(EventListRedGreen);
  112.       NDefProp:0;                 { Index of default property }
  113.       NDefEvent:0);               { Index of default event }
  114. { Register custom control.                     }
  115. { This routine is called by VB when the custom }
  116. { control DLL is loaded for use.               }
  117. function VBInitCC(usVersion:Word;fRunTime:Boolean):Boolean; Export;
  118. begin
  119.   RG:=LoadBitmap(hInstance,'REDGREEN');
  120.   VBInitCC:=VBRegisterModel(hInstance,ModelRedGreen);
  121. end;
  122. Exports
  123.   VBInitCC         index 2,
  124.   RedGreenCtlProc index 3,
  125.   AboutDlgProc;
  126. Begin
  127. End. { End of Custom Control }